VELR_Spreadability
2025-08-30
donwload the data [https://data.mendeley.com/datasets/ntgfb38k69/3]
1- Flow Curve
Variables in the DataFrame:
Shear rate (how fast the material deforms). Shear stress (measured force per unit area). Viscosity (τ/γ̇, ratio of shear stress to shear rate). Torque (motor force generating the deformation).
rutas_archivos <- list.files(path = ".", pattern = "flow_data.csv", recursive = TRUE, full.names = TRUE)
lista_datos <- lapply(rutas_archivos, function(ruta){
read.csv(ruta, skip = 1)
})
names(lista_datos) <- basename(dirname(rutas_archivos))This code is gonna split the viscosity data like this:
Low shear viscosity: between 0.1–1 s⁻¹ Medium shear viscosity: between 10–100 s⁻¹ High shear viscosity: between 500–1000 s⁻¹
The idea is that when you put cream on your skin with your hand, the shear rates are usually in these ranges:
Slow moves: like 0.1–1 s⁻¹ (when you move the cream super slow on your skin). Normal moves: like 10–100 s⁻¹ (when you rub it normally). Fast/strong moves: more than 100 s⁻¹ (when you rub really fast or hard).
names(lista_datos) <- basename(dirname(rutas_archivos))
library(dplyr)
for (i in 1:length(lista_datos)) {
lista_datos[[i]] <- lista_datos[[i]] %>%
mutate(
conc = names(lista_datos[i]), # Añade el nombre del elemento i como columna 'conc'
range_viscosity = case_when(
shear.rate..1.s. <= 10 ~ "Low_shear",
shear.rate..1.s. > 10 & shear.rate..1.s. <= 100 ~ "Medium_shear",
shear.rate..1.s. > 100 ~ "High_shear"
)
)
}
flow_data <- do.call(rbind, lista_datos) %>%
dplyr::rename(shear.rate = shear.rate..1.s., shear.stress = shear.stress..Pa.,
viscosity = viscosity..Pa.s., Torque = Torque..μN.m.)
#flow_dataIn these parts of the code, we calculate the slope of log(viscosity) vs. log(shear rate). This shows how much the viscosity goes down when the shear rate increases. it is call thinning index. If n < 1, it means the material gets thinner when you move it faster.
library(plotly)
flow_data_p <- flow_data %>%
group_by(conc) %>%
ggplot(aes(x = log(shear.rate), y = log(viscosity), colour = conc)) +
geom_line() +
labs(
title = "Curva de Flujo",
x = "Log(Tasa de Cizalla)",
y = "Log(Viscosidad)"
) +
theme_classic()
ggplotly(flow_data_p)library(dplyr)
library(tidyr)
library(broom)
# ajustes de los modelos lineales
flow_data %>%
group_by(conc) %>%
dplyr::do(glance(lm(log(viscosity) ~ log(shear.rate), data = .)))# A tibble: 13 × 13
# Groups: conc [13]
conc r.squared adj.r.squared sigma statistic p.value df logLik
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 NaCl_0.1_XG 0.983 0.983 0.209 20330. 1.85e-315 1 53.8
2 NaCl_0.3_XG 0.984 0.984 0.193 22209. 3.71e-322 1 81.7
3 NaCl_0.4_XG 0.998 0.998 0.0775 187361. 0 1 408.
4 NaCl_0.5_XG 0.997 0.997 0.0850 131044. 0 1 375.
5 NaCl_0.7_XG 0.986 0.986 0.198 24714. 0 1 72.2
6 NaCl_0_XG 0.987 0.987 0.197 26186. 0 1 74.6
7 NaCl_0_XG_2… 0.975 0.974 0.280 5764. 1.37e-121 1 -21.0
8 XG_NaCl_0.05 0.981 0.981 0.236 17937. 5.58e-306 1 9.50
9 XG_NaCl_0.1 0.977 0.977 0.252 14865. 8.28e-292 1 -13.0
10 XG_NaCl_0.3 0.974 0.974 0.225 13370. 7.78e-284 1 27.2
11 XG_NaCl_0.5 0.979 0.979 0.239 16377. 4.12e-299 1 4.85
12 XG_NaCl_0.7 0.978 0.978 0.243 15530. 4.17e-295 1 -0.901
13 XG_NaCl_0.9 0.971 0.971 0.255 11922. 3.04e-275 1 -17.4
# ℹ 5 more variables: AIC <dbl>, BIC <dbl>, deviance <dbl>, df.residual <int>,
# nobs <int>Shear-thinning: the viscosity goes down when the speed is increased
# pendientes Shear-thinning index (n) (n−1).Eso te da el índice de adelgazamiento.
library(janitor)
Shear_thinning <- flow_data %>%
group_by(conc) %>%
dplyr::do(broom::tidy(lm(log(viscosity) ~ log(shear.rate), data = .))) %>%
select(conc,term, estimate, estimate) %>%
tidyr::pivot_wider(names_from = 'term', values_from = 'estimate', names_prefix = '') %>%
rename_with(~ make.names(.), .cols = everything()) %>% # removing parentheses
dplyr::rename(intercept = X.Intercept., Shear_thinning = log.shear.rate.) %>%
select(-intercept)
Shear_thinning# A tibble: 13 × 2
# Groups: conc [13]
conc Shear_thinning
<chr> <dbl>
1 NaCl_0.1_XG -0.473
2 NaCl_0.3_XG -0.457
3 NaCl_0.4_XG -0.533
4 NaCl_0.5_XG -0.489
5 NaCl_0.7_XG -0.495
6 NaCl_0_XG -0.507
7 NaCl_0_XG_2019 -0.480
8 XG_NaCl_0.05 -0.503
9 XG_NaCl_0.1 -0.488
10 XG_NaCl_0.3 -0.413
11 XG_NaCl_0.5 -0.487
12 XG_NaCl_0.7 -0.482
13 XG_NaCl_0.9 -0.442If the slope (n) is around 0.5, the material is shear-thinning. That means its viscosity drops fast when you increase the shear rate. It feels thick at first, but as soon as you rub it, it gets really thin. This matches what we see with the viscosity: high viscosity at low shear rates, but low viscosity at high shear rates.
The next code calculates the average viscosity for each shear rate group: low, medium, and high.
viscosity_range <- flow_data %>%
group_by(conc, range_viscosity) %>%
summarise(avg_viscosity = mean(viscosity), .groups = 'drop') %>%
pivot_wider(names_from = 'range_viscosity', values_from = 'avg_viscosity', names_prefix = 'avgVisc_') %>%
select(conc, avgVisc_Low_shear, avgVisc_Medium_shear, everything())
viscosity_range %>%
pivot_longer(
cols = starts_with("avgVisc_"),
names_to = "shear_type",
values_to = "avg_viscosity"
) %>%
mutate(
shear_type = factor(shear_type, levels = c("avgVisc_Low_shear", "avgVisc_Medium_shear", "avgVisc_High_shear"))
) %>%
ggplot(aes(x = conc, y = avg_viscosity, fill = shear_type)) +
geom_bar(stat = "identity", position = "dodge") +
labs(
title = "Viscosidad Promedio por Tipo de Cizalla",
x = "Muestra",
y = "Viscosidad Promedio",
fill = "Tipo de Cizalla"
) +
theme_classic() +
theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1, size = 7)) 
viscosity_range # A tibble: 13 × 4
conc avgVisc_Low_shear avgVisc_Medium_shear avgVisc_High_shear
<chr> <dbl> <dbl> <dbl>
1 NaCl_0.1_XG 0.296 0.0249 0.00757
2 NaCl_0.3_XG 0.232 0.0223 0.00665
3 NaCl_0.4_XG 0.433 0.0225 0.00672
4 NaCl_0.5_XG 0.300 0.0215 0.00688
5 NaCl_0.7_XG 0.315 0.0235 0.00674
6 NaCl_0_XG 0.455 0.0317 0.00897
7 NaCl_0_XG_2019 0.528 0.0322 0.00936
8 XG_NaCl_0.05 0.415 0.0303 0.00826
9 XG_NaCl_0.1 0.324 0.0260 0.00721
10 XG_NaCl_0.3 0.153 0.0194 0.00605
11 XG_NaCl_0.5 0.304 0.0242 0.00686
12 XG_NaCl_0.7 0.283 0.0232 0.00663
13 XG_NaCl_0.9 0.213 0.0226 0.00670Low shear: High viscosity—could be a thick or heavy cream. Medium shear: Viscosity drops a lot between low and medium shear, so the cream probably feels lighter when you rub it. High shear: Viscosity is very low here—the cream gets thin and spreads easily.
The code then combines the average viscosity data and the thinning index.
flow_curve <- inner_join(x = viscosity_range, y = Shear_thinning, by = "conc")
flow_curve# A tibble: 13 × 5
conc avgVisc_Low_shear avgVisc_Medium_shear avgVisc_High_shear
<chr> <dbl> <dbl> <dbl>
1 NaCl_0.1_XG 0.296 0.0249 0.00757
2 NaCl_0.3_XG 0.232 0.0223 0.00665
3 NaCl_0.4_XG 0.433 0.0225 0.00672
4 NaCl_0.5_XG 0.300 0.0215 0.00688
5 NaCl_0.7_XG 0.315 0.0235 0.00674
6 NaCl_0_XG 0.455 0.0317 0.00897
7 NaCl_0_XG_2019 0.528 0.0322 0.00936
8 XG_NaCl_0.05 0.415 0.0303 0.00826
9 XG_NaCl_0.1 0.324 0.0260 0.00721
10 XG_NaCl_0.3 0.153 0.0194 0.00605
11 XG_NaCl_0.5 0.304 0.0242 0.00686
12 XG_NaCl_0.7 0.283 0.0232 0.00663
13 XG_NaCl_0.9 0.213 0.0226 0.00670
# ℹ 1 more variable: Shear_thinning <dbl>Low shear = first impression. Medium shear = normal experience. High shear = extreme behavior. Slope = how much it changes between these situations.
2. ampl_sweeps.csv
Variables in the DataFrame:
strain [%]: how much it’s stretched/deformed. shear stress [Pa]: the force measured. storage modulus [Pa] (G′): elastic part (stores energy, solid-like). loss modulus [Pa] (G″): viscous part (loses energy, liquid-like).
amplitude sweep data.
library(dplyr)
library(ggplot2)
library(tidyr)
rutas_archivos_ampl_sweeps <- list.files(path = ".", pattern = "ampl_sweeps.csv", recursive = TRUE, full.names = TRUE)
lista_datos_ampl_sweeps <- lapply(rutas_archivos_ampl_sweeps, function(ruta){
read.csv(ruta, skip = 1, sep = c(',',";"))
})
names(lista_datos_ampl_sweeps) <- basename(dirname(rutas_archivos_ampl_sweeps))
for(i in 1:length(lista_datos_ampl_sweeps)){
lista_datos_ampl_sweeps[[i]] <- lista_datos_ampl_sweeps[[i]] %>%
mutate(
conc = as.factor(names(lista_datos_ampl_sweeps[i]))
)
}
ampl_sweeps_df <- do.call(rbind, lista_datos_ampl_sweeps) %>%
dplyr::rename(strain= strain...., shear.stress = shear.stress..Pa.,
storage.modulus = storage.modulus..Pa., loss.modulus = loss.modulus..Pa.)
#ampl_sweeps_dfThis is a general graph of the amplitude sweeps for all 13 samples, showing the loss modulus (G″) and storage modulus (G′).
library(plotly)
ampl_sweeps_g <- ampl_sweeps_df %>%
group_by(conc) %>%
#dplyr::filter(conc == "NaCl_0.5_XG") %>%
slice(c(8:n())) %>%
tidyr::pivot_longer(
cols = c(storage.modulus, loss.modulus),
names_to = "modulus_type",
values_to = "modulus_value"
) %>%
ggplot(aes(x=strain, y = modulus_value, colour = modulus_type)) +
geom_line(
aes(color= conc, linetype = modulus_type)
) +
theme_classic()
ggplotly(ampl_sweeps_g)This shows the linear viscoelastic regions (LVR) of the samples. There’s no clear LVR region in the data.
library(ggmagnify)
library(ggplot2)
from <- c(xmin = 5, xmax = 45, ymin = 0.15, ymax = 0.25)
to <- c(500, 1500 , 0.15, 0.35)
ampl_sweeps_df %>%
filter(conc == 'NaCl_0.1_XG') %>%
pivot_longer(cols = c(storage.modulus, loss.modulus),
names_to = 'modulus_type',
values_to = 'modulus_value') %>%
ggplot(aes(x=strain, y = modulus_value, colour = modulus_type, label = modulus_type)) +
geom_line() +
theme_classic() +
ggmagnify::geom_magnify(from = from,
to = to,axes = "xy",
proj = "facing",colour = "black",
linetype = 1, proj.fill = alpha("yellow", 0.1))
G′ and G″ in the linear zone show the initial texture: firmness vs. flow. Using the average G′ and G″ in the LVR zone (even though there’s no clear LVR).
Even if there’s no obvious LVR, zooming into the first data points shows a short linear region.
# VELR PLOTS
ampl_sweeps_df %>%
group_by(conc) %>%
mutate(
diff_loss =abs(loss.modulus-lag(loss.modulus)) # se resta el valor loss.modulus con su anterior para obtener residuo
) %>%
dplyr::filter(
diff_loss <= 0.015, # se filtran residuos menores a 0.015, para obtener los puntos mas cercanos
loss.modulus >= mean(.$loss.modulus[.$diff_loss < 0.015], na.rm = T) # se siltran los valores de loss.modulus mayor a su media
) %>%
select(-diff_loss) %>%
pivot_longer(
cols = c(storage.modulus, loss.modulus),
names_to = "modulus_type",
values_to = "modulus_value"
) %>%
ggplot(aes(x=strain, y = modulus_value, colour = modulus_type)) +
geom_line(
aes(color= conc, linetype = modulus_type)
) +
theme_classic() 
G′/G″ (tan δ) More elastic or more liquid at the start. tan δ < 1 → elastic material (firm gel). tan δ > 1 → viscous material (fluid).
mean_modulsdf <- ampl_sweeps_df %>%
group_by(conc) %>%
mutate(
diff_loss =abs(loss.modulus-lag(loss.modulus)) # se resta el valor loss.modulus con su anterior para obtener residuo
) %>%
dplyr::filter(
diff_loss <= 0.015, # se filtran residuos menores a 0.015, para obtener los puntos mas cercanos
loss.modulus >= mean(loss.modulus[diff_loss < 0.015], na.rm = T)# se siltran los valores de loss.modulus mayor a su media
) %>%
select(-diff_loss) %>%
pivot_longer(
cols = c(storage.modulus, loss.modulus),
names_to = "modulus_type",
values_to = "modulus_value"
) %>%
group_by(modulus_type,conc) %>%
summarise(mean_modul = mean(modulus_value),.groups= 'drop') %>%
pivot_wider(names_from = modulus_type, values_from = mean_modul) %>%
mutate(tangent_delta = loss.modulus/storage.modulus) %>%
rename(avg_loss.modulus = loss.modulus, avg_storage.modulus = storage.modulus)
mean_modulsdf# A tibble: 13 × 4
conc avg_loss.modulus avg_storage.modulus tangent_delta
<fct> <dbl> <dbl> <dbl>
1 NaCl_0.1_XG 0.209 0.193 1.08
2 NaCl_0.3_XG 0.184 0.167 1.10
3 NaCl_0.4_XG 0.198 0.174 1.14
4 NaCl_0.5_XG 0.190 0.180 1.05
5 NaCl_0.7_XG 0.204 0.191 1.07
6 NaCl_0_XG 0.336 0.377 0.891
7 NaCl_0_XG_2019 0.424 0.367 1.15
8 XG_NaCl_0.05 0.278 0.303 0.918
9 XG_NaCl_0.1 0.230 0.254 0.906
10 XG_NaCl_0.3 0.199 0.159 1.25
11 XG_NaCl_0.5 0.226 0.221 1.02
12 XG_NaCl_0.7 0.213 0.202 1.05
13 XG_NaCl_0.9 0.229 0.211 1.09 Yield strain (γ_yield) The point where G′ drops 10–20% from its LVR value shows how much deformation it can handle before breaking. This gives the yield shear stress (τ_yield)—the force needed to break the internal structure.
γ_yield and τ_yield are calculated based on the 20% drop in G′ after the LVR.
# Vector con los valores de Gprime_threshold
Gprime_threshold <- mean_modulsdf$avg_storage.modulus * 0.8 # para calcular el 20 % de decaimineto del loss module
thresholds <- setNames(object = Gprime_threshold, nm = levels(ampl_sweeps_df$conc))
y_strain_stress <- ampl_sweeps_df %>%
group_by(conc) %>%
dplyr::filter(storage.modulus >= thresholds[as.character(first(conc))]) %>%
slice_tail(n = 1) %>%
ungroup() %>%
rename(yield_strain = strain, yield_stress = shear.stress) %>%
select(-storage.modulus,-loss.modulus)
y_strain_stress# A tibble: 13 × 3
yield_strain yield_stress conc
<dbl> <dbl> <fct>
1 65.8 0.171 NaCl_0.1_XG
2 93.5 0.21 NaCl_0.3_XG
3 86.3 0.207 NaCl_0.4_XG
4 72.6 0.171 NaCl_0.5_XG
5 84.1 0.209 NaCl_0.7_XG
6 82.4 0.379 NaCl_0_XG
7 86.1 0.377 NaCl_0_XG_2019
8 85.2 0.309 XG_NaCl_0.05
9 81.4 0.256 XG_NaCl_0.1
10 111. 0.254 XG_NaCl_0.3
11 89.9 0.254 XG_NaCl_0.5
12 77.8 0.207 XG_NaCl_0.7
13 112. 0.310 XG_NaCl_0.9 Dinal Dataframe
ampl_sweep <- inner_join(x = mean_modulsdf, y = y_strain_stress, by = 'conc')
ampl_sweep# A tibble: 13 × 6
conc avg_loss.modulus avg_storage.modulus tangent_delta yield_strain
<fct> <dbl> <dbl> <dbl> <dbl>
1 NaCl_0.1_XG 0.209 0.193 1.08 65.8
2 NaCl_0.3_XG 0.184 0.167 1.10 93.5
3 NaCl_0.4_XG 0.198 0.174 1.14 86.3
4 NaCl_0.5_XG 0.190 0.180 1.05 72.6
5 NaCl_0.7_XG 0.204 0.191 1.07 84.1
6 NaCl_0_XG 0.336 0.377 0.891 82.4
7 NaCl_0_XG_20… 0.424 0.367 1.15 86.1
8 XG_NaCl_0.05 0.278 0.303 0.918 85.2
9 XG_NaCl_0.1 0.230 0.254 0.906 81.4
10 XG_NaCl_0.3 0.199 0.159 1.25 111.
11 XG_NaCl_0.5 0.226 0.221 1.02 89.9
12 XG_NaCl_0.7 0.213 0.202 1.05 77.8
13 XG_NaCl_0.9 0.229 0.211 1.09 112.
# ℹ 1 more variable: yield_stress <dbl>